home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 4 / Amiga Tools 4.iso / grafix / tools / playfkiss / src / edit_cel.e < prev    next >
Text File  |  1996-02-26  |  25KB  |  868 lines
  1.  
  2. /* Edit CEL v 1.50 */
  3.  
  4. /*
  5.     No copyright is claimed for *any* material within.
  6.   This source is *currently* Public Domain, and therefore open to free exploitation. */
  7.  
  8. /* Use at your own risk, and watch for hairy palms. */
  9.  
  10.  
  11. /*  November 9, 1994
  12.                                              Chad Randall 
  13.                                                         - mbissaymssiK Software, broken spork division
  14.                         Internet:  crandall@garnet.msen.com
  15.                             USNail:  229 S.Washington St.
  16.                                              Manchester, Michigan, 48158-9680 USA */
  17.  
  18. /* This sucker's not been tested but on my machine.  So let me know about any probs, 'kay? */
  19.  
  20. OPT LARGE
  21.  
  22. MODULE    'graphics/rastport','graphics/gfx','graphics/text','graphics/scale','graphics/view',
  23.                 'graphics/gfxbase','graphics/clip','graphics/layers','graphics/displayinfo'
  24. MODULE    'layers'
  25. MODULE    'utility','mathffp','datatypes','iffparse'
  26. MODULE    'intuition/intuition','intuition/screens','intuition/gadgetclass','intuition/screens',
  27.                 'intuition/pointerclass'
  28. MODULE    'libraries/gadtools','gadtools'
  29. MODULE    'doloaddt','libraries/doloaddt'
  30. MODULE    'dos/dos'
  31. MODULE    'libraries/asl','asl'
  32. MODULE    'tools/async'
  33. MODULE    'wb','workbench/workbench','workbench/startup'
  34. MODULE    'icon'
  35. MODULE    'exec/memory'
  36.  
  37. MODULE    '*i3_subs'
  38. MODULE    '*i3_procs'
  39. MODULE    'mod/filenames'
  40. MODULE    'mod/compare'
  41. MODULE    'mod/menus'
  42.  
  43. ENUM OLD_,NEW_
  44. ENUM    DRAG_TOP,DRAG_PAUSE,DRAG_DIRTY,DRAG_BUFFER,DRAG_SMART
  45.  
  46. OBJECT color
  47.     red:LONG
  48.     grn:LONG
  49.     blu:LONG
  50. ENDOBJECT
  51.  
  52. OBJECT palet
  53.     color[260]:ARRAY OF color
  54. ENDOBJECT
  55.  
  56.  
  57. DEF filename[500]:STRING
  58. DEF paletname[500]:STRING
  59. DEF dtname[500]:STRING
  60. DEF ppmname[500]:STRING
  61.  
  62. DEF vp:PTR TO viewport,cm,depth,scrw,scrh,menu,vis
  63. DEF rp:PTR TO rastport,winw,winh
  64.  
  65. DEF textfont,textattr,textstyle=0
  66.  
  67. DEF quit=FALSE,newproj=FALSE
  68. DEF mode=0
  69. DEF config_size_x,config_size_y
  70.  
  71. DEF disp:PTR TO rastport
  72. DEF scr:PTR TO screen
  73. DEF win:PTR TO window,outwin:PTR TO window
  74. DEF fixxed=FALSE,rtdrag=4,waittof=TRUE,hand=FALSE,bound=TRUE
  75. DEF string[500]:STRING
  76. DEF iconbmap=0:PTR TO bitmap,iconwidth,iconheight,oldx,oldy
  77. DEF copybmap=0:PTR TO bitmap,copyrast:PTR TO rastport
  78. DEF backbmap=0:PTR TO bitmap,backrast:PTR TO rastport
  79. DEF maskbmap=0:PTR TO bitmap
  80. DEF blankbmap=0:PTR TO bitmap,maximumw=1,maximumh=1
  81. DEF palet=0:PTR TO palet
  82. DEF hand1=0,hand2=0,hand3=0
  83. DEF curobj=0,offx,offy,dragmode=0
  84. DEF filereq=0:PTR TO filerequester
  85. DEF paletreq=0:PTR TO filerequester
  86. DEF dtreq=0:PTR TO filerequester
  87. DEF ppmreq=0:PTR TO filerequester
  88. ENUM OFF=FALSE,ON=TRUE
  89. DEF outputmode=0
  90. DEF pauseflag=FALSE
  91. DEF iinfo:PTR TO imageinfo
  92. DEF goodload,xsize,ysize,nxsize,nysize,xoff,yoff
  93. DEF tbmp:PTR TO bitmap
  94.  
  95. CONST FILE_MARK_CELL=$20,FILE_MARK_PALET=$10
  96.  
  97.  
  98. RAISE "CHIP" IF AllocBitMap()=FALSE
  99. RAISE "MEM" IF AllocMem()=FALSE
  100. RAISE "MEM" IF New()=FALSE
  101. RAISE "^C" IF CtrlC()=TRUE
  102.  
  103. PROC version()
  104.     WriteF('\s',{versionstring})
  105. ENDPROC
  106.  
  107. versionstring:
  108. CHAR    '\0$VER: edit cel 1.50 (26.1.96) \tPUBLIC DOMAIN --- NOT FOR RESALE\0\0'
  109.  
  110. PROC reportmousemoves(win:PTR TO window)
  111.     Forbid()
  112.     win.flags:=win.flags OR WFLG_REPORTMOUSE
  113.     Permit()
  114. ENDPROC
  115. PROC noreportmousemoves(win:PTR TO window);DEF flag
  116.     Forbid()
  117.     flag:=win.flags
  118.     IF (flag AND WFLG_REPORTMOUSE) THEN flag:=flag-WFLG_REPORTMOUSE
  119.     win.flags:=flag
  120.     Permit()
  121. ENDPROC
  122.  
  123. PROC busy()
  124.     SetWindowPointerA(win,[$80000098,TRUE,WA_POINTERDELAY,TRUE,NIL,NIL])
  125.     ModifyIDCMP(win,IDCMP_MENUPICK)
  126.     StrCopy(string,'Edit CEL 1.50  *BUSY*',ALL)
  127.     SetWindowTitles(win,-1,string)
  128. ENDPROC
  129.  
  130. PROC ready()
  131.     ClearPointer(win)
  132.     ModifyIDCMP(win,IDCMP_MENUPICK OR IDCMP_MENUVERIFY)
  133.     StringF(string,'Edit CEL 1.50  (\dx\d)',xsize,ysize)
  134.     SetWindowTitles(win,-1,string)
  135. ENDPROC
  136.  
  137.  
  138. PROC main() HANDLE
  139.     DEF i,ii,t,zz,tt,zzz
  140.     DEF mes:PTR TO intuimessage
  141.     DEF hit,hitflag=0,palload=0,iadd:PTR TO menuitem,drawx,drawy
  142.     DEF dir[500]:STRING,file[250]:STRING,buffer
  143.     DEF args:PTR TO wbarg,wstr[250]:STRING,toolobject=NIL:PTR TO diskobject
  144.     DEF region1,rectangle:PTR TO rectangle
  145.     DEF olddir,dirrr,wb:PTR TO wbstartup
  146.     DEF argarray[32]:LIST,rdarg=0,gotme=0,check,code=0,du=0
  147.     DEF zx,zy,zw,zh,zox,zoy
  148.     DEF oldfh=0,newfh=0,filebuf=0,bufptr,filelen=1
  149.     DEF menuverify=FALSE
  150.     DEF fh1,fbuf=0,byte_h,byte_l,r,g,b,bpp,numc
  151.  
  152.     IF (KickVersion(39)=0)
  153.         Raise("Kick")
  154.     ENDIF
  155.  
  156.     buffer:=New(260*16)
  157.     NEW palet,iinfo
  158.     IF (doloaddtbase:=OpenLibrary('doloaddt.library',2))=NIL THEN Raise("DLDT")
  159.     IF (iconbase:=OpenLibrary('icon.library', 37))=NIL THEN Raise("ICOL")
  160.     IF (aslbase:=OpenLibrary('asl.library', 37))=NIL THEN Raise("ASL")
  161.     IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN Raise("GT")
  162.     IF (layersbase:=OpenLibrary('layers.library',37))=NIL THEN Raise("LAY")
  163.  
  164.     IF (iffparsebase:=OpenLibrary('iffparse.library',39))=NIL THEN Raise("IFFP")
  165.     IF (utilitybase:=OpenLibrary('utility.library',39))=NIL THEN Raise("UTIL")
  166.     IF (datatypesbase:=OpenLibrary('datatypes.library',39))=NIL THEN Raise("DT")
  167.     IF (mathbase:=OpenLibrary('mathffp.library',37))=NIL THEN Raise("MFFP")
  168.  
  169.     IF wbmessage<>NIL
  170.         outputmode:=TRUE
  171.         wb:=wbmessage;args:=wb.arglist
  172.         olddir:=CurrentDir(args.lock)
  173.         IF args.name>0
  174.             GetCurrentDirName(wstr,250)
  175.             StrCopy(filename,wstr,ALL);AddPart(filename,'',490)
  176.             StrAdd(wstr,args.name,ALL)
  177.             toolobject:=GetDiskObjectNew(wstr)
  178.             CurrentDir(olddir)
  179.         ENDIF
  180.         IF wb.numargs>1
  181.             olddir:=args[].lock++ ->skip our lock! olddir is meaningless at this point
  182.             IF args.lock
  183.                 olddir:=CurrentDir(args.lock)
  184.                 GetCurrentDirName(filename,490)
  185.                 NameFromLock(args.lock,wstr,240)
  186.                 CurrentDir(olddir)
  187.                 AddPart(filename,args.name,490)
  188.                 StrCopy(dtname,filename,ALL)
  189.                 StrCopy(ppmname,filename,ALL)
  190.                 StrCopy(paletname,filename,ALL)
  191.             ENDIF
  192.         ENDIF
  193.         IF (toolobject<>0)
  194.             IF (du:=FindToolType(toolobject.tooltypes,'DEPTH'))
  195.                 StrToLong(du,{rtdrag})
  196.                 IF rtdrag<4 THEN rtdrag:=4
  197.                 IF rtdrag>4 THEN rtdrag:=8
  198.             ENDIF
  199.             IF (du:=FindToolType(toolobject.tooltypes,'PICTURE_DIRECTORY'))
  200.                 StrCopy(dtname,du,ALL)
  201.                 AddPart(dtname,'',490)
  202.                 StrCopy(ppmname,du,ALL)
  203.                 AddPart(ppmname,'',490)
  204.             ENDIF
  205.             IF (du:=FindToolType(toolobject.tooltypes,'PICDIR'))
  206.                 StrCopy(dtname,du,ALL)
  207.                 AddPart(dtname,'',490)
  208.             ENDIF
  209.             IF (du:=FindToolType(toolobject.tooltypes,'KISS_DIRECTORY'))
  210.                 StrCopy(filename,du,ALL)
  211.                 AddPart(filename,'',490)
  212.                 StrCopy(paletname,du,ALL)
  213.                 AddPart(paletname,'',490)
  214.             ENDIF
  215.             IF (du:=FindToolType(toolobject.tooltypes,'CELDIR'))
  216.                 StrCopy(filename,du,ALL)
  217.                 AddPart(filename,'',490)
  218.             ENDIF
  219.             IF (du:=FindToolType(toolobject.tooltypes,'KCFDIR'))
  220.                 StrCopy(paletname,du,ALL)
  221.                 AddPart(paletname,'',490)
  222.             ENDIF
  223.             IF (du:=FindToolType(toolobject.tooltypes,'INITIAL_KCF'))
  224.                 StrCopy(paletname,du,ALL)
  225.                 palload:=555
  226.             ENDIF
  227.             FreeDiskObject(toolobject)
  228.         ENDIF
  229.     ELSE
  230.         FOR i:=0 TO 30
  231.             argarray[i]:=NIL
  232.         ENDFOR
  233.         rdarg:=ReadArgs('WORKDIR=K,PICDIR=P,KCF/K,DEPTH=D/N',argarray,0)
  234.         IF rdarg
  235.             IF argarray[0]
  236.                 StrCopy(filename,argarray[0],ALL)
  237.                 AddPart(filename,'',490)
  238.                 StrCopy(paletname,argarray[0],ALL)
  239.                 AddPart(paletname,'',490)
  240.                 StrCopy(dtname,argarray[0],ALL)
  241.                 AddPart(dtname,'',490)
  242.                 StrCopy(ppmname,argarray[0],ALL)
  243.                 AddPart(ppmname,'',490)
  244.             ENDIF
  245.             IF argarray[1]
  246.                 StrCopy(dtname,argarray[1],ALL)
  247.                 AddPart(dtname,'',490)
  248.                 StrCopy(ppmname,argarray[1],ALL)
  249.                 AddPart(ppmname,'',490)
  250.             ENDIF
  251.             IF argarray[2]
  252.                 StrCopy(paletname,argarray[2],ALL)
  253.                 palload:=555
  254.             ENDIF
  255.             IF argarray[3]
  256.                 rtdrag:=argarray[3]
  257.                 rtdrag:=^rtdrag
  258.                 IF rtdrag<4 THEN rtdrag:=4
  259.                 IF rtdrag>4 THEN rtdrag:=8
  260.             ENDIF
  261.             FreeArgs(rdarg)
  262.         ENDIF
  263.     ENDIF
  264.  
  265.     filereq:=AllocAslRequest(ASL_FILEREQUEST,[ASLFR_INITIALPATTERN,'#?.CEL',NIL,NIL])
  266.     paletreq:=AllocAslRequest(ASL_FILEREQUEST,[ASLFR_INITIALPATTERN,'#?.KCF',NIL,NIL])
  267.     dtreq:=AllocAslRequest(ASL_FILEREQUEST,[ASLFR_INITIALPATTERN,'#?',NIL,NIL])
  268.     ppmreq:=AllocAslRequest(ASL_FILEREQUEST,[ASLFR_INITIALPATTERN,'#?.ppm',NIL,NIL])
  269.  
  270.     scr:=LockPubScreen('Workbench')
  271.     config_size_x:=scr.width
  272.     config_size_y:=(scr.height+scr.barheight+1)
  273.     UnlockPubScreen(0,scr);scr:=0
  274.     openscreen(rtdrag)
  275.     GetRGB32(cm,0,256,buffer)
  276.     FOR i:=0 TO 255
  277.         palet.color[i].red:=Long(buffer+(i*12))
  278.         palet.color[i].grn:=Long(buffer+(i*12)+4)
  279.         palet.color[i].blu:=Long(buffer+(i*12)+8)
  280.     ENDFOR
  281.     WHILE quit=FALSE
  282.         updatecolors()
  283.         WHILE ((quit=FALSE) AND (newproj=FALSE))
  284.             Wait(-1)
  285.             CtrlC()
  286.             hitflag:=0
  287.             WHILE (mes:=Gt_GetIMsg(win.userport))
  288.                 IF (mes.class=IDCMP_MENUVERIFY)
  289.                     menucolors(buffer)
  290.                 ENDIF
  291.                 IF (mes.class=IDCMP_MENUPICK)
  292.                     code:=mes.code
  293.                     WHILE (code<>MENUNULL)
  294.                         iadd:=ItemAddress(menu,code)
  295.                         IF iadd
  296.                             hit:=Long(iadd+34)
  297.                             check:=(Int(iadd+12) AND CHECKED)
  298.                             IF ((hit>0) AND (hit<10)) THEN hitflag:=hit
  299.                             IF hit=66 THEN quit:=TRUE
  300.                             code:=iadd.nextselect
  301.                         ELSE
  302.                             code:=MENUNULL
  303.                         ENDIF
  304.                     ENDWHILE
  305.                     updatemenucolors()
  306.                 ENDIF
  307.           Gt_ReplyIMsg(mes)
  308.             ENDWHILE
  309.             IF (palload) THEN hitflag:=1
  310.             SELECT hitflag
  311.             CASE 1
  312.                 busy()
  313.                 IF palload=0
  314.                     WbenchToFront()
  315.                     splitname(paletname,dir,file)
  316.                     ii:=AslRequest(paletreq,[ASL_HAIL,'Open which .KCF file?',
  317.                             ASL_OKTEXT,'Open',ASL_FILE,file,ASL_DIR,dir,
  318.                             ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,FALSE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  319.                     WbenchToBack()
  320.                 ELSE
  321.                     ii:=TRUE
  322.                 ENDIF
  323.                 IF ii
  324.                     IF palload=0
  325.                         StrCopy(paletname,paletreq.drawer,ALL)
  326.                         AddPart(paletname,paletreq.file,490)
  327.                     ENDIF
  328.                     fh1:=Open(paletname,MODE_OLDFILE)
  329.                     IF fh1
  330.                         fbuf:=New(500)
  331.                         Read(fh1,fbuf,32)
  332.                         IF Long(fbuf)="KiSS"
  333.                             IF Char(fbuf+4)=FILE_MARK_PALET
  334.                                 bpp:=Char(fbuf+5)
  335.                                 numc:=ibmconv(Int(fbuf+8))
  336.                                 FOR i:=0 TO numc-1
  337.                                     IF bpp=12
  338.                                         Read(fh1,fbuf,2)
  339.                                         byte_l:=Char(fbuf)
  340.                                         byte_h:=Char(fbuf+1)
  341.                                         r:=(Shr(byte_l,4) AND $F)*$1111
  342.                                         g:=(byte_h AND $F)*$1111
  343.                                         b:=(byte_l AND $F)*$1111
  344.                                     ELSE
  345.                                         Read(fh1,fbuf,1);r:=Shl(Char(fbuf),8) OR Char(fbuf)
  346.                                         Read(fh1,fbuf,1);g:=Shl(Char(fbuf),8) OR Char(fbuf)
  347.                                         Read(fh1,fbuf,1);b:=Shl(Char(fbuf),8) OR Char(fbuf)
  348.                                     ENDIF
  349.                                     r:=(Shl(Shl(r,8),8) OR r)
  350.                                     g:=(Shl(Shl(g,8),8) OR g)
  351.                                     b:=(Shl(Shl(b,8),8) OR b)
  352.                                     palet.color[i].red:=r
  353.                                     palet.color[i].grn:=g
  354.                                     palet.color[i].blu:=b
  355.                                 ENDFOR
  356.                             ENDIF
  357.                         ELSE
  358.                             Seek(fh1,0,OFFSET_BEGINNING)
  359.                             FOR i:=0 TO 15
  360.                                 Read(fh1,fbuf,2)
  361.                                 byte_l:=Char(fbuf)
  362.                                 byte_h:=Char(fbuf+1)
  363.                                 r:=(Shr(byte_l,4) AND $F)*$1111
  364.                                 g:=(byte_h AND $F)*$1111
  365.                                 b:=(byte_l AND $F)*$1111
  366.                                 r:=(Shl(Shl(r,8),8) OR r)
  367.                                 g:=(Shl(Shl(g,8),8) OR g)
  368.                                 b:=(Shl(Shl(b,8),8) OR b)
  369.                                 palet.color[i].red:=r
  370.                                 palet.color[i].grn:=g
  371.                                 palet.color[i].blu:=b
  372.                             ENDFOR
  373.                         ENDIF
  374.                         Dispose(fbuf)
  375.                         Close(fh1)
  376.                         updatecolors()
  377.                     ENDIF
  378.                 ENDIF
  379.             CASE 2
  380.                 busy()
  381.                 WbenchToFront()
  382.                 splitname(filename,dir,file)
  383.                 ii:=AslRequest(filereq,[ASL_HAIL,'Open which .CEL file?',
  384.                         ASL_OKTEXT,'Open',ASL_FILE,file,ASL_DIR,dir,
  385.                         ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,FALSE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  386.                 WbenchToBack()
  387.                 IF ii
  388.                     StrCopy(filename,filereq.drawer,ALL)
  389.                     AddPart(filename,filereq.file,490)
  390.                     fh1:=Open(filename,MODE_OLDFILE)
  391.                     IF fh1
  392.                         fbuf:=New(8000)
  393.                         SetRast(rp,0)
  394.                         Read(fh1,fbuf,4)
  395.                         IF Long(fbuf)="KiSS"
  396.                             Read(fh1,fbuf,28)
  397.                             IF Char(fbuf)=FILE_MARK_CELL
  398.                                 nxsize:=ibmconv(Int(fbuf+4))
  399.                                 IF (nxsize/2)<>((nxsize+1)/2) THEN nxsize:=nxsize+1
  400.                                 nysize:=ibmconv(Int(fbuf+6))
  401.                                 xoff:=ibmconv(Int(fbuf+8))
  402.                                 yoff:=ibmconv(Int(fbuf+10))
  403.                                 xsize:=nxsize+xoff
  404.                                 ysize:=nysize+yoff
  405.                                 bpp:=Char(fbuf+1)
  406.                                 IF bpp=4
  407.                                     FOR t:=0 TO nysize-1
  408.                                         Read(fh1,fbuf,((nxsize+1)/2))
  409.                                         FOR i:=0 TO (nxsize) STEP 2
  410.                                             byte_h:=Char(fbuf+(i/2))
  411.                                             SetAPen(rp,Shr(byte_h AND $F0,4))
  412.                                             WritePixel(rp,xoff+i,yoff+t)
  413.                                             SetAPen(rp,byte_h AND $F)
  414.                                             WritePixel(rp,xoff+i+1,yoff+t)
  415.                                         ENDFOR
  416.                                     ENDFOR
  417.                                 ELSE
  418.                                     FOR t:=0 TO nysize-1
  419.                                         Read(fh1,fbuf,nxsize)
  420.                                         FOR i:=0 TO nxsize-1
  421.                                             byte_h:=Char(fbuf+i)
  422.                                             SetAPen(rp,byte_h)
  423.                                             WritePixel(rp,xoff+i,xoff+t)
  424.                                         ENDFOR
  425.                                     ENDFOR
  426.                                 ENDIF
  427.                             ELSE
  428.                                 DisplayBeep(0)
  429.                             ENDIF
  430.                         ELSE
  431.                             nxsize:=ibmconv(Int(fbuf))
  432.                             IF (nxsize/2)<>((nxsize+1)/2) THEN nxsize:=nxsize+1
  433.                             nysize:=ibmconv(Int(fbuf+2))
  434.                             IF ((nxsize<2) OR (nxsize>640) OR (nysize<2) OR (nysize>400))
  435.                                 DisplayBeep(0)
  436.                             ELSE
  437.                                 xsize:=nxsize
  438.                                 ysize:=nysize
  439.                                 FOR t:=0 TO ysize-1
  440.                                     Read(fh1,fbuf,((xsize+1)/2))
  441.                                     FOR i:=0 TO (xsize) STEP 2
  442.                                         byte_h:=Char(fbuf+(i/2))
  443.                                         SetAPen(rp,Shr(byte_h AND $F0,4))
  444.                                         WritePixel(rp,i,t)
  445.                                         SetAPen(rp,byte_h AND $F)
  446.                                         WritePixel(rp,i+1,t)
  447.                                     ENDFOR
  448.                                 ENDFOR
  449.                             ENDIF
  450.                         ENDIF
  451.                         Dispose(fbuf)
  452.                         Close(fh1)
  453.                     ENDIF
  454.                 ENDIF
  455.             CASE 3
  456.                 busy()
  457.                 WbenchToFront()
  458.                 splitname(dtname,dir,file)
  459.                 ii:=AslRequest(dtreq,[ASL_HAIL,'Open which Picture file?',
  460.                         ASL_OKTEXT,'Open',ASL_FILE,file,ASL_DIR,dir,
  461.                         ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,FALSE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  462.                 WbenchToBack()
  463.                 IF ii
  464.                     StrCopy(dtname,dtreq.drawer,ALL)
  465.                     AddPart(dtname,dtreq.file,490)
  466.                 ENDIF
  467.                 textattr:=['topaz.font',8,0,0]:textattr
  468.                 textfont:=OpenFont(textattr)
  469.                 goodload:=(Doloaddt(dtname,rp,cm,0,0,config_size_x,config_size_y,[DLDT_CENTER,FALSE,
  470.                     DLDT_DITHERTYPE,DITH_FLOYD,
  471.                     DLDT_REMAP,TRUE,
  472.                     DLDT_ASPECTX,1,
  473.                     DLDT_ASPECTY,1,
  474.                     DLDT_SCALE,FALSE,
  475.                     DLDT_USEASPECT,FALSE,
  476.                     DLDT_CLEAR,TRUE,
  477.                     DLDT_INFO,iinfo,
  478.                     DLDT_STATWINDOW,[scr,0,16,textfont,textattr,textstyle,'Loading...','Scaling...','histo','quant','Rendering','Cancel','Loading Datatype',dtname]:statwindow,
  479.                     DLDT_ACTIVATESTATWINDOW,TRUE,
  480.                     DLDT_HIGHPEN,-1,NIL,NIL]))
  481.                 CloseFont(textattr)
  482.                 IF goodload=0
  483.                     xsize:=(iinfo.destination_w+1)/2*2
  484.                     ysize:=iinfo.destination_h
  485.                 ENDIF
  486.             CASE 4
  487.                 menucolors(buffer)
  488.                 EasyRequestArgs(win,[20,0,'Load .ppm file...',
  489.                     'Loading a .ppm file is not implemented yet.',
  490.                     'Ok'],0,0)
  491.                 updatemenucolors()
  492. ->                busy()
  493. ->                WbenchToFront()
  494. ->                splitname(ppmname,dir,file)
  495. ->                ii:=AslRequest(ppmreq,[ASL_HAIL,'Select ppm file',
  496. ->                        ASL_OKTEXT,'Open',ASL_FILE,file,ASL_DIR,dir,
  497. ->                        ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,FALSE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  498. ->                WbenchToBack()
  499. ->                IF ii
  500. ->                    StrCopy(ppmname,ppmreq.drawer,ALL)
  501. ->                    AddPart(ppmname,ppmreq.file,490)
  502. ->                ENDIF
  503.             CASE 5
  504.                 busy()
  505.                 WbenchToFront()
  506.                 splitname(paletname,dir,file)
  507.                 ii:=AslRequest(paletreq,[ASL_HAIL,'Save .KCF file as',
  508.                         ASL_OKTEXT,'Save',ASL_FILE,file,ASL_DIR,dir,
  509.                         ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,TRUE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  510.                 WbenchToBack()
  511.                 IF ii
  512.                     StrCopy(paletname,paletreq.drawer,ALL)
  513.                     AddPart(paletname,paletreq.file,490)
  514.                     fh1:=Open(paletname,MODE_NEWFILE)
  515.                     IF fh1
  516.                         fbuf:=New(500)
  517.                         FOR i:=0 TO 31
  518.                             PutChar(fbuf,0)
  519.                         ENDFOR
  520.                         PutLong(fbuf,"KiSS")
  521.                         PutChar(fbuf+4,FILE_MARK_PALET)
  522.                         PutChar(fbuf+5,24)
  523.                         PutInt(fbuf+8,ibmconv(IF depth=4 THEN 16 ELSE 256))
  524.                         PutInt(fbuf+10,ibmconv(10))
  525.                         Write(fh1,fbuf,32)
  526.                         FOR t:=0 TO 9
  527.                             FOR i:=0 TO IF (depth=4) THEN 15 ELSE 255
  528.                                 PutChar(fbuf+(i*3),palet.color[i].red)
  529.                                 PutChar(fbuf+(i*3)+1,palet.color[i].grn)
  530.                                 PutChar(fbuf+(i*3)+2,palet.color[i].blu)
  531.                             ENDFOR
  532.                             Write(fh1,fbuf,IF (depth=4) THEN 16*3 ELSE 256*3)
  533.                         ENDFOR
  534.                         Dispose(fbuf)
  535.                         Close(fh1)
  536.                     ENDIF
  537.                 ENDIF
  538.             CASE 6
  539.                 busy()
  540.                 WbenchToFront()
  541.                 splitname(filename,dir,file)
  542.                 ii:=AslRequest(filereq,[ASL_HAIL,'Save .CEL file as',
  543.                         ASL_OKTEXT,'Save',ASL_FILE,file,ASL_DIR,dir,
  544.                         ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,TRUE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  545.                 WbenchToBack()
  546.                 IF ii
  547.                     StrCopy(filename,filereq.drawer,ALL)
  548.                     AddPart(filename,filereq.file,490)
  549.                     xoff:=xsize
  550.                     FOR i:=0 TO ysize
  551.                         FOR t:=0 TO xoff
  552.                             IF ReadPixel(rp,t,i)<>0
  553.                                 xoff:=smaller(xoff,t)
  554.                                 t:=xoff
  555.                             ENDIF
  556.                         ENDFOR
  557.                     ENDFOR
  558.                     yoff:=ysize
  559.                     FOR i:=0 TO xsize
  560.                         FOR t:=0 TO yoff
  561.                             IF ReadPixel(rp,i,t)<>0
  562.                                 yoff:=smaller(yoff,t)
  563.                                 t:=yoff
  564.                             ENDIF
  565.                         ENDFOR
  566.                     ENDFOR
  567.                     xsize:=((xsize-xoff+1)/2)*2+1
  568.                     ysize:=ysize-yoff+1
  569.                     ClipBlit(rp,xoff,yoff,rp,0,0,xsize,ysize,192)
  570.                     SetAPen(rp,0)
  571.                     RectFill(rp,xsize,0,3000,2000)
  572.                     RectFill(rp,0,ysize,3000,2000)
  573.  
  574.                     nxsize:=0
  575.                     FOR i:=ysize TO 0 STEP -1
  576.                         FOR t:=xsize TO nxsize STEP -1
  577.                             IF ReadPixel(rp,t,i)<>0
  578.                                 nxsize:=t
  579.                                 t:=nxsize
  580.                             ENDIF
  581.                         ENDFOR
  582.                     ENDFOR
  583.                     nysize:=0
  584.                     FOR i:=xsize TO 0 STEP -1
  585.                         FOR t:=ysize TO nysize STEP -1
  586.                             IF ReadPixel(rp,i,t)<>0
  587.                                 nysize:=t
  588.                                 t:=nysize
  589.                             ENDIF
  590.                         ENDFOR
  591.                     ENDFOR
  592.                     xsize:=((nxsize+1)/2)*2+1
  593.                     ysize:=nysize+1
  594.  
  595.                     fh1:=Open(filename,MODE_NEWFILE)
  596.                     IF fh1
  597.                         fbuf:=New(6000)
  598.                         FOR i:=0 TO 31
  599.                             PutChar(fbuf,0)
  600.                         ENDFOR
  601.                         PutLong(fbuf,"KiSS")
  602.                         PutChar(fbuf+4,FILE_MARK_CELL)
  603.                         PutChar(fbuf+5,IF (depth=4) THEN 4 ELSE 8)
  604.                         PutInt(fbuf+8, ibmconv(xsize))
  605.                         PutInt(fbuf+10,ibmconv(ysize))
  606.                         PutInt(fbuf+12,ibmconv(xoff))
  607.                         PutInt(fbuf+14,ibmconv(yoff))
  608.                         Write(fh1,fbuf,32)
  609.                         IF (depth=4)
  610.                             FOR t:=0 TO ysize-1
  611.                                 FOR i:=0 TO (xsize-1) STEP 2
  612.                                     PutChar(fbuf+(i/2),(Shl(ReadPixel(rp,i,t) AND $F,4) OR (ReadPixel(rp,i+1,t) AND $F)))
  613.                                 ENDFOR
  614.                                 Write(fh1,fbuf,((xsize+1)/2))
  615.                             ENDFOR
  616.                         ELSE
  617.                             FOR t:=0 TO ysize-1
  618.                                 FOR i:=0 TO xsize-1
  619.                                     PutChar(fbuf+i,ReadPixel(rp,i,t))
  620.                                 ENDFOR
  621.                                 Write(fh1,fbuf,xsize)
  622.                             ENDFOR
  623.                         ENDIF
  624.                         Close(fh1)
  625.                         Dispose(fbuf)
  626.                     ENDIF
  627.                 ENDIF
  628.                 ClipBlit(rp,0,0,rp,xoff,yoff,xsize,ysize,192)
  629.                 SetAPen(rp,0)
  630.                 IF ((xoff>0)) THEN     RectFill(rp,0,0,xoff-1,1000)
  631.                 IF ((yoff>0)) THEN     RectFill(rp,0,0,1000,yoff-1)
  632.                 xsize:=xsize+xoff
  633.                 ysize:=ysize+yoff
  634.             CASE 7
  635.                 busy()
  636.                 WbenchToFront()
  637.                 splitname(dtname,dir,file)
  638.                 ii:=AslRequest(dtreq,[ASL_HAIL,'Save IFF file as',
  639.                         ASL_OKTEXT,'Save',ASL_FILE,file,ASL_DIR,dir,
  640.                         ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,TRUE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  641.                 WbenchToBack()
  642.                 IF ii
  643.                     StrCopy(dtname,dtreq.drawer,ALL)
  644.                     AddPart(dtname,dtreq.file,490)
  645.                     tbmp:=AllocBitMap(xsize,ysize,depth,BMF_STANDARD,scr.rastport.bitmap)
  646.                     IF tbmp
  647.                         BltBitMap(scr.rastport.bitmap,0,scr.barheight+1,tbmp,0,0,xsize,ysize,192,$FFFFFFFF,0)
  648.                         saveclip(dtname,tbmp,vp,xsize,ysize)
  649.                         FreeBitMap(tbmp)
  650.                     ENDIF
  651.                 ENDIF
  652.             CASE 8
  653.                 busy()
  654.                 WbenchToFront()
  655.                 splitname(ppmname,dir,file)
  656.                 ii:=AslRequest(ppmreq,[ASL_HAIL,'Save ppm file as',
  657.                         ASL_OKTEXT,'Save',ASL_FILE,file,ASL_DIR,dir,
  658.                         ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,TRUE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  659.                 WbenchToBack()
  660.                 IF ii
  661.                     StrCopy(ppmname,ppmreq.drawer,ALL)
  662.                     AddPart(ppmname,ppmreq.file,490)
  663.                 ENDIF
  664.             CASE 9
  665.                 menucolors(buffer)
  666.                 EasyRequestArgs(win,[20,0,'About Edit CEL 1.50',
  667.                     'Written in a few hours\n(plus one more)\nby\nChad Randall\ncrandall@msen.com',
  668.                     'Ok'],0,0)
  669.                 updatemenucolors()
  670.             ENDSELECT
  671.             ready();palload:=FALSE
  672.         ENDWHILE
  673.     ENDWHILE    
  674.     closescreen()
  675. EXCEPT DO
  676.  
  677.     SELECT exception
  678.     CASE 0;NOP
  679.     CASE "DLDT";err('Missing doloaddt.library')
  680.     CASE "ICOL";err('Missing icon.library')
  681.     CASE "IFFP";err('Missing iffparse.library')
  682.     CASE "MFFP";err('Missing mathffp.library')
  683.     CASE "KEYM";err('Missing keymap.library')
  684.     CASE "UTIL";err('Missing utility.library')
  685.     CASE "GT";err('Missing gadtools.library')
  686.     CASE "ASL";err('Missing asl.library')
  687.     CASE "LAY";err('Missing layers.library')
  688.     CASE "DT";err('Missing datatype.library')
  689.     CASE "MEM";err('Not enough memory.')
  690.     CASE "CHIP";err('Not enough CHIP memory.')
  691.     CASE "^C";err('***Break')
  692.     CASE "Egui";err('EasyGUI error.')
  693.     CASE "bigg";err('EasyGUI too big!')
  694.     CASE "SCR";err('Can\at open screen.')
  695.     CASE "WIN";err('Can\at open window.')
  696.     CASE "MENU";err('Can\at create menu.')
  697.     CASE "VIS";err('Can\t obtain visual structure.')
  698.     CASE "file";err('File error.')
  699.     CASE "err";err('Misc. error?')
  700.     ENDSELECT
  701.  
  702.     closescreen()
  703.     Dispose(buffer)
  704.     IF ((exception="^C") AND (outputmode=0)) THEN WriteF('***BREAK\n')
  705.     IF ((exception="Kick"))
  706.         WriteF('You need at least OS 3.0 (Kickstart 39) to run.\n')
  707.         DisplayBeep(0)
  708.     ENDIF
  709.     IF filereq THEN FreeAslRequest(filereq)
  710.     IF dtreq THEN FreeAslRequest(dtreq)
  711.     IF paletreq THEN FreeAslRequest(paletreq)
  712.     IF ppmreq THEN FreeAslRequest(ppmreq)
  713.     IF doloaddtbase THEN CloseLibrary(doloaddtbase)
  714.     IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  715.     IF layersbase THEN CloseLibrary(layersbase)
  716.     IF aslbase THEN CloseLibrary(aslbase)
  717.     IF iconbase THEN CloseLibrary(iconbase)
  718.     END palet
  719. ENDPROC
  720.  
  721. PROC menucolors(buffer)
  722.     DEF i
  723.     FOR i:=0 TO 3
  724.         SetRGB32(vp,i,Long(buffer+(i*12)),Long(buffer+(i*12)+4),Long(buffer+(i*12)+8))
  725.     ENDFOR
  726.     FOR i:=17 TO 19
  727.         SetRGB32(vp,i,Long(buffer+(i*12)),Long(buffer+(i*12)+4),Long(buffer+(i*12)+8))
  728.     ENDFOR
  729.     FOR i:=(Shl(1,rtdrag)-4) TO (Shl(1,rtdrag)-1)
  730.         SetRGB32(vp,i,Long(buffer+(i*12)),Long(buffer+(i*12)+4),Long(buffer+(i*12)+8))
  731.     ENDFOR
  732. ENDPROC
  733.  
  734. PROC updatemenucolors()
  735.     DEF i
  736.     FOR i:=0 TO 3
  737.         SetRGB32(vp,i,palet.color[i].red,palet.color[i].grn,palet.color[i].blu)
  738. ->        SetRGB32(vp,i,Long(buffer+(i*12)),Long(buffer+(i*12)+4),Long(buffer+(i*12)+8))
  739.     ENDFOR
  740.     FOR i:=17 TO 19
  741.         SetRGB32(vp,i,palet.color[i].red,palet.color[i].grn,palet.color[i].blu)
  742. ->        SetRGB32(vp,i,Long(buffer+(i*12)),Long(buffer+(i*12)+4),Long(buffer+(i*12)+8))
  743.     ENDFOR
  744.     FOR i:=(Shl(1,rtdrag)-4) TO (Shl(1,rtdrag)-1)
  745.         SetRGB32(vp,i,palet.color[i].red,palet.color[i].grn,palet.color[i].blu)
  746. ->        SetRGB32(vp,i,Long(buffer+(i*12)),Long(buffer+(i*12)+4),Long(buffer+(i*12)+8))
  747.     ENDFOR
  748. ENDPROC
  749.  
  750. PROC updatecolors()
  751.     DEF i,pn=0,t
  752.     FOR i:=0 TO 255
  753.         SetRGB32(vp,i,palet.color[i].red,palet.color[i].grn,palet.color[i].blu)
  754.     ENDFOR
  755. ENDPROC
  756.  
  757. PROC isdigit(s);IF (((s>="0") AND (s<="9")) OR (s=".") OR (s="-")) THEN RETURN TRUE;ENDPROC FALSE
  758. PROC isalpha(s);IF (((s>="a") AND (s<="z")) OR ((s>="A") AND (s<="Z"))) THEN RETURN TRUE;ENDPROC FALSE
  759. PROC ispunc(s);IF ((s=".") OR (s="-") OR (s="_")) THEN RETURN TRUE;ENDPROC FALSE
  760.  
  761. PROC scanforvalue(str)
  762.     DEF l=0,i,s[100]:STRING,ins,iii=0
  763.     WHILE (isdigit(Char(str+l)));l:=l+1;ENDWHILE
  764.     StrCopy(s,str,l)
  765.     ins:=InStr(str,'.')
  766.     IF ((ins>0) AND (ins<=l))
  767.         StrToLong(s,{i})
  768.         StrToLong(s+ins+1,{iii})
  769.     ELSE
  770.         StrToLong(s,{i})
  771.     ENDIF
  772. ENDPROC i,l,iii
  773.  
  774. PROC scanforstring(str)
  775.     DEF l=0
  776.     WHILE (isdigit(Char(str+l)) OR isalpha(Char(str+l)) OR ispunc(Char(str+l)));l:=l+1;ENDWHILE
  777. ENDPROC l
  778.  
  779. PROC ibmconv(a)
  780.     DEF hi,lo,ret
  781.     hi:=a AND $FF00
  782.     lo:=a AND $00FF
  783.     ret:=Shl(lo,8) OR Shr(hi,8)
  784. ENDPROC ret
  785.  
  786. PROC openscreen(d)
  787.     DEF cflag,lflag1=CHECKIT,lflag2=CHECKIT,lflag3=CHECKIT,lflag4=CHECKIT,lflag5=CHECKIT,lflag=CHECKIT
  788.     DEF hflag1=CHECKIT,hflag2=CHECKIT,hflag3=CHECKIT,bflag=CHECKIT
  789.     depth:=d
  790.     scr:=OpenScreenTagList(NIL,[SA_LIKEWORKBENCH,TRUE,
  791.         SA_DEPTH,depth,
  792.         SA_TITLE,'Edit CEL',
  793.         SA_COLORMAPENTRIES,256,
  794.         SA_FULLPALETTE,TRUE,
  795.         SA_WIDTH,config_size_x,
  796.         SA_HEIGHT,config_size_y,
  797.         SA_INTERLEAVED,TRUE,
  798.         SA_AUTOSCROLL,TRUE,
  799.         SA_PENS,[-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1]:INT,
  800.         NIL,NIL])
  801.     IF scr=0 THEN Raise("SCR")
  802.     IF (vis:=GetVisualInfoA(scr,NIL))=0 THEN RETURN "VIS"
  803.     win:=OpenWindowTagList(0,[WA_WIDTH,scr.width,WA_HEIGHT,scr.height-scr.barheight-1,
  804.         WA_TOP,scr.barheight+1,WA_LEFT,0,
  805.         WA_FLAGS,WFLG_ACTIVATE OR WFLG_SMART_REFRESH,
  806.         WA_BORDERLESS,TRUE,
  807.         WA_BACKDROP,TRUE,
  808.         WA_CUSTOMSCREEN,scr,
  809.         WA_NEWLOOKMENUS,TRUE,
  810.         WA_IDCMP,IDCMP_MENUPICK OR IDCMP_MENUVERIFY,
  811.         NIL,NIL])
  812.     IF win=0 THEN Raise("WIN")
  813.     vp:=scr.viewport
  814.     cm:=vp.colormap
  815.     rp:=win.rport
  816.  
  817.   IF (menu:=CreateMenusA([NM_TITLE,0,'Project',0,0,0,0,
  818.                                                     NM_ITEM,0,'Open KCF...','K',0,0,1,
  819.                                                     NM_ITEM,0,'Open CEL...','C',0,0,2,
  820.                                                     NM_ITEM,0,'Open Datatype...','O',0,0,3,
  821.                                                     NM_ITEM,0,'Open PPM (P6)','P',0,0,4,
  822.                                                     NM_ITEM,0,NM_BARLABEL,0,0,0,0,
  823.                                                     NM_ITEM,0,'Save KCF','F',0,0,5,
  824.                                                     NM_ITEM,0,'Save CEL','E',0,0,6,
  825.                                                     NM_ITEM,0,'Save IFF','I',0,0,7,
  826.                                                     NM_ITEM,0,'Save PPM (P6)','B',0,0,8,
  827.                                                     NM_ITEM,0,NM_BARLABEL,0,0,0,0,
  828.                                                     NM_ITEM,0,'About','?',0,0,9,
  829.                                                     NM_ITEM,0,'Quit','Q',0,0,66,
  830.  
  831.                                                     NM_END,0,'End','x',0,0,0]:newmenu,NIL))=NIL THEN Raise("MENU")
  832.     LayoutMenusA(menu,vis,[GTMN_NEWLOOKMENUS,TRUE,NIL,NIL])
  833.     SetMenuStrip(win,menu)
  834.     offmenu(4)
  835.     offmenu(8)
  836. ENDPROC
  837.  
  838. PROC offmenu(id);DEF a,b,c;a,b,c:=findmenuid(menu,id);IF win THEN OffMenu(win,packmenunumber(a,b,c));ENDPROC
  839. PROC onmenu(id);DEF a,b,c;a,b,c:=findmenuid(menu,id);IF win THEN OnMenu(win,packmenunumber(a,b,c));ENDPROC
  840.  
  841. PROC closescreen()
  842.     IF win
  843.         CloseWindow(win)
  844.         win:=0
  845.     ENDIF
  846.     IF menu
  847.         FreeMenus(menu)
  848.         menu:=0
  849.     ENDIF
  850.     IF vis
  851.         FreeVisualInfo(vis)
  852.         vis:=0
  853.     ENDIF
  854.     IF scr
  855.         CloseScreen(scr)
  856.         scr:=0
  857.     ENDIF
  858.  
  859. ENDPROC
  860.  
  861. PROC err(msgptr)
  862.     IF ((aslbase<>0))
  863.          EasyRequestArgs(0,[20,0,'Error!',msgptr,'Okay'],0,0)
  864.     ELSE
  865.         WriteF('\s\n',msgptr)
  866.     ENDIF
  867. ENDPROC
  868.